;; EX-19.scm - Tempo based scheduling.

;; Create a schedule.  Pulse are at integer UTC times, which makes
;; correctness checks easier to make.

(define t (make-tschedule 60 (ceiling (utc))))

;; Ping instrument.

(synthdef-store
 (synthdef
  "ping"
  ((out 0) (freq 440))
  (Out.ar out (Pan2.ar (SinOsc.ar freq 0 (EnvGen.kr envelope: (Env.perc) 
						    doneAction: 2))
		       (Rand.ir -1 1)
		       (Rand.ir 0.2 0.4)))))

;; Ping procedure.

(define-procedure (ping f t)
  (=> t (list "/s_new" "ping" -1 1 1 "freq" f)))

;; Test ping

(ping 440 (utc))

;; Regular pings.

(tschedule-at/next
 t (lambda (pulse time) 
     (ping (random '(220 440 880)) time)
     1))

;; Change tempo to random value.

(let ((new (random '(60 120 180 240 300 360 420 480 540))))
  (inform "New tempo:" new)
  (set-tschedule-ppm! t new))

;; Clear tschedule.

(tschedule-clear! t)

;; Simple polyrhythm starting on next pulse.

(begin 
  (tschedule-at/next t (lambda (pulse time) (ping 440 time) 2))
  (tschedule-at/next t (lambda (pulse time) (ping 220 time) 3)))

;; Unary pulse that will be synchronized with the polyrhythm above.

(tschedule-at/next t (lambda (pulse time) (ping (* 220 2/3) time) 1))

;; Test out of order scheduling.

(let ((now (tschedule-current-pulse t)))
  (for-each (lambda (f i)
	      (tschedule-at t (+ i now) (lambda (pulse time) (ping f time))))
	    '(660 330 220 550 440)
	    '(1   0.2 0.1 0.6 0.5)))

;; Immediate ping using delta scheduler.

(tschedule-at/interval t 0 (lambda (pulse time) (ping (random '(221 441 881)) time)))

;; No pings

(tschedule-clear! t)

;; Map <ctl> #24 to set the tempo.

(begin (ctl-setup! (c 24) "tempo" (make-spec 30 90 'exponential) 60)
       (define (tempo-setter index pre post state) 
	 (set-tschedule-ppm! t (floor-exact post)))
       (ctl-recv-add! (c 24) tempo-setter)
       (controller-interface 1 1 24))

;; Slow high pings and fast low pings.

(begin
  (set-tschedule-ppm! t 90)
  (tschedule-at/next t (lambda (pulse time) (ping (random '(880 1760)) time) 1))
  (tschedule-at/next t (lambda (pulse time) 
			 (ping (random (list 55 110 220 (* 220 2/3) 440 (* 440 2/3))) time)
			 1/6)))

(tschedule-clear! t)
